perm filename USR.SAI[DLN,MRC]1 blob
sn#453547 filedate 1979-06-29 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "User FTP" comment Macros and variable definitions
C00010 00003 DOCLS, MAKEDIRN and CHECK_DIALNETHOST
C00013 00004 CONNECT to remote host.
C00021 00005 GETREPLY and SENDCOMMAND interact with Dialnet.
C00029 00006 Get server's REPLY
C00033 00007 DSKtoDLN
C00036 00008 DLNtoDSK
C00041 00009 USER issues log-in sequence.
C00044 00010 DATA sets the transfer parameters
C00047 00011 ABORT, BYE, HELP,STATUS and IDLING.
C00050 00012 RETRIEVE gets data files from server
C00056 00013 STORE sends data files to the server
C00066 00014 command-table macros
C00070 00015 MIN_MATCH command in the table and DOCOMMAND
C00076 00016 Main user program. Initializations
C00080 00017 Run!!
C00082 ENDMK
C⊗;
BEGIN "User FTP" comment Macros and variable definitions
;
REQUIRE "{}{}" DELIMITERS;
DEFINE ! = { comment };
DEFINE # = { ;comment };
DEFINE newline = {('15&'12)};
DEFINE tab = {('11&null)};
DEFINE THRU = { STEP 1 UNTIL };
DEFINE UPTO = { ←1 STEP 1 UNTIL };
DEFINE BEGINLOOP={ WHILE TRUE DO BEGIN };
DEFINE ALPHA = {"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"};
DEFINE NUMER = {"0123456789"};
DEFINE INTIMS_INX = {13} # index for INTIMS interrupts (which close the
connection);
DEFINE loc = {location}, line = {memory};
DEFINE Apnd = {TRUE}, NoApnd = {FALSE};
DEFINE NoWait = {'40000000};
DEFINE ascii = {1} , image = {2} # types of data;
DEFINE receiving= {1} , sending = {2} # modes of TransferActive;
DEFINE chances = {3} # passwords one can try after giving a `USER' command;
DEFINE rh(t) = {((t) land '000000777777)} # right half of word;
DEFINE lh(t) = {((t) land '777777000000)} # light half of word;
DEFINE pos(t) = {((t) lsh -30)} # position field in a byte pointer;
DEFINE ACfield = {'40000000} # 1 in accumulator field in an instruction;
DEFINE errorcode= { rh(DSKflag) } # select error codes for LOOKUP and ENTER;
! Reply codes;
DEFINE Dn = {'104};
DEFINE Bsy = {'102};
DEFINE Failed = {'106};
DEFINE Ok = {'117};
DEFINE Stopped = {'123};
INTEGER DLNIOWORD # IOWORD for DLN;
DEFINE DLNEOF = { DLNIOWORD LAND '400 } # end of file for Dialnet device;
DEFINE CLEAR!DLNIOWORD = { BEGIN CODE(DLNSETST,memory['17]);DLNIOWORD ← '17 END };
! Instruction codes for CODE statement;
INTEGER MTAPE,DLNINPUT,DLNOUTPUT,DLNSETST,DLNGETST # Dialnet commands;
INTEGER PTJOBX,LEYPOS # UUO's employed in reading passwords;
INTEGER DON,DONN # line number and control function for PTJOBX DON;
INTEGER DOFF,DOFFF # line number and control function for PTJOBX DOFF;
EXTERNAL INTEGER _SKIP_ # successful return from CODE?;
! Memory blocks employed by Dialnet MTAPES;
INTEGER RPCcode,RPChpid,RPClpid,RPCwin,RPCdn1,RPCdn2,RPCdn3,RPCdn4;
INTEGER CLScode;
INTEGER EOFcode,EOFchan;
INTEGER INTcode,INTchan;
INTEGER FBOcode;
INTEGER WFCcode;
! Parameters for opening DLN and DSK devices;
INTEGER DLNcount,DLNchan,DLNbreak,notopen,DLNflag;
INTEGER DSKcount,DSKchan,DSKbreak,DSKeof,DSKflag;
! For tuning up the system. dskwords MUST be even;
DEFINE dskwords={256},
asciibytes = {(dskwords*5)}, asciiwords = {dskwords},
imagbytes = {((dskwords*9+1) div 2)}, imagwords = {((imagbytes+3) div 4)},
databufsize = {(imagwords+2)} # avoid clobberages;
DEFINE comwords= {128}, combytes ={(comwords*5)};
DEFINE repwords= {128}, repbytes ={(repwords*5)};
DEFINE windowsize ={8} # to be sent with RPC;
! Buffer for image data from disk;
INTEGER ARRAY imagbuf[0:dskwords+1];
! Buffer for Dialnet data (both coming in and going out);
INTEGER ARRAY databuf[0:databufsize-1];
DEFINE ascii0 = {POINT(7,databuf[0],-1)},
imag0 = {POINT(8,databuf[0],-1)} # first byte in data buffer;
INTEGER datap,datacount,datachan # pointer,count and channel;
! Buffer for commands;
SAFE INTEGER ARRAY combuf[0:comwords-1];
DEFINE com0 ={POINT(7,combuf[0],-1)} # pointer to first byte in command buffer;
INTEGER comp,comcount,comchan # pointer,count and channel;
! Buffer for replies;
SAFE INTEGER ARRAY repbuf[0:repwords-1];
DEFINE rep0 ={POINT(7,repbuf[0],-1)} # pointer to first byte in reply buffer;
INTEGER repp,repcount,repchan # pointer,count and channel;
INTEGER reptosee # number of reply bytes remaining in buffer;
INTEGER TransferActive, Closing # states of the connection;
INTEGER StatusRequest # number of status requests issued and not yet received;
STRING command,args # components of a kommand;
INTEGER bytesize,type # logical byte size and type for data transmission;
INTEGER inhibit # to avoid spies,inhibit has code to temporarily inhibit the
<control><cr> feature that reloads the terminal buffer;
INTEGER blind # =27, to obtain TTYSET 27 = no peek;
INTEGER nospy,nopeek # addresses of `inhibit' and `blind';
INTEGER nbytes # byte count for statistics of RETRIEVE and STORE;
SAFE INTEGER ARRAY InfoArray[1:6] # for info about files;
INTEGER filesize # size of file to store;
INTEGER skipspaces,oneword,oneatom,fname,uptoquote # break tables;
INTEGER chr # break character used to read fields of strings;
Comment DOCLS, MAKEDIRN and CHECK_DIALNETHOST;
SIMPLE PROCEDURE DoCLS # executed when Closing;
Closing ← TRUE;
DEFINE makedir(n,d) = ! Convert the SIXBIT directory name n into a string d;
{ BEGIN d←CVXSTR(n); d←"[" & d[1 to 3] & "," & d[4 to 6] & "]" END
};
DEFINE net(h) = {(h land '777000000000)};
DEFINE Dialnet= {(22 lsh 27)};
DEFINE check_DLNhost(syte,tel,host) =
! If the site is a Dialnet host, then make tel point to its TelCo number.
In any case host will point to the official host name;
{ BEGIN INTEGER ad;
ad ← rh(table[syte]);
host← table[syte] lsh -18;
WHILE ad DO BEGIN
IF net(table[ad])=Dialnet THEN BEGIN
tel ← rh(table[ad]); DONE END;
ad ← rh(table[ad+1]) END
END
};
DEFINE match = ! Is dname within match bounds ? ;
{(smin[0]<dname[0] or (smin[0]=dname[0] and
(smin[1]<dname[1] or (smin[1]=dname[1] and smin[2]≤dname[2])))) and
(smax[0]>dname[0] or (smax[0]=dname[0] and
(smax[1]>dname[1] or (smax[1]=dname[1] and smax[2]≥dname[2]))))
};
SIMPLE STRING PROCEDURE get_fname;
! Gets the name of a file from the head of args and deletes it there;
BEGIN "Get file name" STRING fn,drn;
SCAN(args,skipspaces,chr);
IF chr="↓" THEN BEGIN ! Garbled file name;
fn←LOP(args)&SCAN(args,uptoquote,chr);
chr←LOP(args);
IF chr="." THEN BEGIN fn←fn&chr&LOP(args)&SCAN(args,uptoquote,chr);
chr ← LOP(args) END
END
ELSE fn ← SCAN(args,fname,chr);
IF chr="[" THEN BEGIN ! File name includes directory;
drn ← "[" & SCAN(args,oneatom,chr) & "," & SCAN(args,oneatom,chr) & "]";
chr←LOP(args) # look at next character;
END
ELSE drn←"" # let the system do the work;
RETURN( fn&drn )
END "Get file name";
Comment CONNECT to remote host.
;
BOOLEAN PROCEDURE connect;
! Looks for the TelCo number of the destination host in HOSTS2.BIN[NET,MRC]
and issues the RPC.
In case of ambiguity the host with the shortest name is prefrerred. Upon
this, the Dialnet host with the shortest name will be preferred;
BEGIN "Connect" INTEGER i,k;STRING t;
INTEGER fp # pointer in HOSTS2 file;
BOOLEAN z # signals end of ASCIZ string;
BOOLEAN onematch # a host matching the argument has been found;
INTEGER firstname,entrys,endnames # first entry,size and size of NAMES table;
SAFE INTEGER ARRAY smin,smax,sname,dname[0:2] # to match upto 15 ASCII characters;
INTEGER site,TelCo,hostp,hostn # of matching host in table;
STRING hostname,hosTel # official name and TelCo number of host;
STRING device # DLN0 or DLN1;
DEFINE fixsgn(n) = {(n xor '400000000000)};
LOOKUP(DSKchan,"HOSTS2.BIN[NET,MRC]",DSKflag);
IF DSKflag THEN PRINT(newline," Sorry, the host table is not available now.")
ELSE BEGIN FILEINFO(InfoArray); fp ← -(InfoArray[4] rot 18) END;
BEGIN SAFE INTEGER ARRAY table[0:fp];
IF not DSKflag THEN BEGIN
ARRYIN(DSKchan,table[0],fp) # input table;
fp ← table[8] # address of NAMES table;
firstname ← fp+2 # pointer to first entry in NAMES table;
entrys ← table[fp+1] # size of one entry in NAMES table;
endnames ← fp+1+table[fp]*entrys # size of NAMES table (-2);
END;
BEGINLOOP "Try"
LABEL try;
IF DSKflag THEN BEGIN "Request number from user"
PRINT(NEWLINE,"HOST TELCO NUMBER (ten consecutive digits, <cr> to quit):");
IF (hosTel←INCHWL)="" THEN RETURN(false)
ELSE BEGIN k←loc(RPCdn1);
WHILE hosTel DO BEGIN memory[k]←CVASC(hosTel);
hosTel←hosTel[5 to ∞]; k←k+1 END END
END "Request number from user"
ELSE
BEGIN "With host table"
! Get destination name in suitable format;
PRINT(NEWLINE,"HOST NAME (<cr> to quit):");
IF (hostname←INCHWL)="" THEN RETURN(false);
FOR k←0 THRU 2 DO BEGIN sname[k]←CVASC(hostname);
hostname←hostname[6 to ∞] END;
FOR k←0 THRU 2 do BEGIN "Bounds for matching"
smin[k] ← fixsgn(sname[k]);
smax[k] ← fixsgn(CVASC(CVASTR(sname[k])&'177&'177&'177&'177&'177))
END "Bounds for matching";
! Search NAMES table. Match first 15 characters of name;
onematch ← FALSE # no match yet;
TelCo ← 0; # none in Dialnet;
FOR i←firstname STEP entrys UNTIL endnames DO
BEGIN "check name"
fp ← rh(table[i]) # address of name;
z ← FALSE # zero byte not yet seen in ASCIZ string;
FOR k←0 THRU 2 DO ! get name in suitable format;
IF z THEN dname[k] ← fixsgn(0)
ELSE BEGIN t←CVASTR(table[fp+k]);
IF LENGTH(t)<5 THEN z←TRUE;
dname[k] ← fixsgn(CVASC(t)) END;
IF match THEN BEGIN
site ← table[i] lsh -18;
check_DLNhost(site,TelCo,hostn);
IF not onematch THEN
BEGIN hostp←hostn;onematch←TRUE END;
IF TelCo THEN BEGIN hostp←hostn;DONE "check name" END
END
END "check name";
IF onematch THEN BEGIN "Found match in Dialnet"
hostname ←"" # put official name in host name;
DO BEGIN t←CVASTR(table[hostp]); hostname←hostname&t;
hostp ← hostp+1 END
UNTIL LENGTH(t)<5;
hosTel ←"";
IF TelCo THEN
IF EQU(hostname,"SU-AI") THEN BEGIN "Don't dial"
RPCdn1←RPCdn2←RPCdn3←RPCdn4←0;
device ← "DLN1" END "Don't dial"
ELSE BEGIN "Get TelCo number"
k ← loc(RPCdn1);
DO BEGIN t←CVASTR(table[TelCo]);hosTel←hosTel&t;
memory[k]←table[TelCo];
k←k+1; TelCo←TelCo+1 END
UNTIL LENGTH(t)<5;
device ← "DLN0";
END "Get TelCo number"
ELSE BEGIN PRINT(newline,hostname&" is not a Dialnet host yet!!");
CONTINUE END END "Found match in Dialnet"
ELSE BEGIN PRINT(newline,"Unrecognized host name.");CONTINUE END
END "With host table";
! Try to get Dialnet device;
OPEN(DLNchan,device,'17,0,0,imagbytes,DLNbreak,notopen);
IF notopen THEN BEGIN PRINT(newline,"Can`t open ",device); CONTINUE END;
! Fill rest of RPC block;
RPCcode ← 0;
RPChpid ← '106124120000;RPClpid←0 # `FTP' always;
RPCwin ← windowsize # window size;
! Request process connection;
try: CODE(MTAPE,RPCcode) # issue request;
IF not _SKIP_ THEN BEGIN PRINT(newline,"Dialer error. Code:"&CVASTR(RPCcode));
CONTINUE END;
PRINT(newline,"Trying...");
CODE(MTAPE,WFCcode) # wait for connection;
IF not _SKIP_ THEN BEGIN
PRINT(newline,"Connection refused. Try again? (Y or N):");
IF INCHRW="Y" THEN GOTO try;
CONTINUE END;
PRINT(newline,"Connecting to ",IF DSKflag THEN "" ELSE hostname,"(",hosTel,")...",
newline,newline);
CLOSE(DSKchan);
RETURN(true)
END "Try"
END
END "Connect";
Comment GETREPLY and SENDCOMMAND interact with Dialnet.
;
SIMPLE PROCEDURE getReply;
! Fill in block and issue DLNINPUT UUO to read one byte forcibly. If next packet is
end_of_file or comes on a channel other than 0, getReply will discard it and try
again otherwise it will proceed copying control data into the reply buffer;
BEGIN "getReply"
BEGINLOOP
repp ← rep0; repcount ← 1; repchan ← 2;
CODE(DLNINPUT,repp); CODE(DLNGETST,DLNIOWORD);
IF Closing THEN RETURN;
repp ← repp+NoWait; repcount ← repbytes+repcount-1;
IF repchan=2 THEN DONE;
IF DLNEOF THEN CONTINUE;
CODE(DLNINPUT,repp) # skip data packets;
IF Closing THEN RETURN; END;
CODE(DLNINPUT,repp);CODE(DLNGETST,DLNIOWORD);
repp←rep0; reptosee ← repbytes-repcount;
END "getReply";
SIMPLE PROCEDURE sendCommand(STRING Kommand);
! Puts the Kommand in the control buffer and sends it out on channel 0. Kommands
should never be more than `combytes' long;
BEGIN "Send String"
comcount ← LENGTH(Kommand);
comp ← com0;
WHILE (chr←LOP(Kommand)) DO IDPB(chr,comp);
comp ← com0;
CODE(DLNOUTPUT,comp); CODE(MTAPE,FBOcode);
END "Send String";
Comment Get server's REPLY
;
INTEGER PROCEDURE reply;
! Types the reply at the user's terminal and returns a reply code.
If there is no message for the user,it shows that the reply has arrived
by going to a newline. It will call `getReply' until the whole reply has
shown up.
If there is more than one reply, only one of them will be passed but `reptosee'
will be updated.
Notice that `reply' will hang until it receives a whole reply on chan 0;
BEGIN "Reply" INTEGER nestcnt,repcode;
IF Closing THEN RETURN(Failed);
! Look for left parenthesis;
DO BEGIN
IF reptosee=0 THEN BEGIN getReply;IF Closing THEN return(Failed) END;
chr←ILDB(repp); reptosee←reptosee-1 END
UNTIL (chr="(");
! Now for reply code;
DO BEGIN
IF reptosee=0 THEN BEGIN getReply;IF Closing THEN return(Failed) END;
repcode←ILDB(repp); reptosee←reptosee-1 END
UNTIL (repcode≠" ");
PRINT(newline);
! Skip rest of reply word, and blanks, up to the message for the human user;
DO BEGIN
IF reptosee=0 THEN BEGIN getReply;IF Closing THEN return(Failed) END;
chr←ILDB(repp); reptosee←reptosee-1 END
UNTIL (chr="(") OR (chr=")");
nestcnt ← IF chr=")" THEN 0 ELSE 1;
IF nestcnt>0 THEN
BEGINLOOP
IF reptosee=0 THEN BEGIN getReply;IF Closing THEN return(Failed) END;
chr←ILDB(repp); reptosee←reptosee-1;
IF chr=")" THEN BEGIN nestcnt←nestcnt-1;
IF nestcnt=0 THEN DONE END
ELSE IF chr="(" THEN BEGIN PRINT(newline);nestcnt←nestcnt+1 END;
OUTCHR(chr) END;
chr ← LDB(repp);
WHILE (reptosee>0) and (chr≠"(") DO ! skip until next `(';
BEGIN chr←ILDB(repp);
reptosee←reptosee-1 END;
PRINT(newline) ;
RETURN(IF repcode≥"a" THEN (repcode-'40) ELSE repcode);
END "Reply";
Comment DSKtoDLN
;
SIMPLE PROCEDURE DSKtoDLN;
! Reads into the data buffer(if eof is not reached first) from the file open on
the channel DSKchan and outputs its data contents to DLN (in channel
DLNchan) on the FTP channel 0 .;
BEGIN "ODM" INTEGER i,w,ww;
IF type=ascii THEN BEGIN ! Take data directly into Dialnet buffer;
ARRYIN(DSKchan,databuf[0],dskwords);
datap ← ascii0; # clear buffer;
datacount ← IF DSKeof THEN rh(DSKeof)*5 ELSE asciibytes;
nbytes ← nbytes+datacount END
ELSE BEGIN ! Must reformat data;
ARRYIN(DSKchan,imagbuf[0],dskwords) # input data to special image buffer;
datap ← imag0 # clear Dialnet buffer;
datacount ← IF DSKeof THEN rh(DSKeof) ELSE dskwords;
nbytes ← nbytes+datacount # update number of bytes obtained from disk;
FOR i←0 THRU datacount-1 DO BEGIN ! convert two words at a time;
w←imagbuf[i];
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
i←i+1; ww←w; w←imagbuf[i];
IDPB(ww + w lsh 4,datap); w ← w lsh -4;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap) END;
datap←imag0;
datacount ← (datacount*9+1) div 2 # converting logical bytes into Dialnet bytes;
END;
IF Closing THEN RETURN;
CODE(DLNOUTPUT,datap);
END "ODM";
Comment DLNtoDSK
;
SIMPLE PROCEDURE DLNtoDSK;
! Reads from DLN (channel DLNchan) on FTP channel 1 and writes on the file open
for input on channel DSKchan.
Start by filling in block and issuing DLNINPUT UUO to read one byte forcibly.
If next packet is end_of_file or comes on a channel other than 0 then return
otherwise proceed copying data into the buffer.;
BEGIN "IDM" INTEGER temp_count,temp_p; INTEGER i,w;
temp_count ← datacount; temp_p←datap;
datacount ← 1;
CODE(DLNINPUT,datap);CODE(DLNGETST,DLNIOWORD);
datacount ← IF datap=temp_p THEN temp_count ELSE temp_count-1 # datacount is not accurate;
IF datachan≠0 THEN RETURN;
IF (datacount≠0) and not DLNEOF THEN BEGIN "Read more"
datap ← datap+NoWait;
CODE(DLNINPUT,datap);CODE(DLNGETST,DLNIOWORD);
datap ← datap-NoWait END "Read more";
IF datacount=0 THEN ! Buffer is full. Pass contents to disk;
IF type=ascii THEN BEGIN ! Pass data as is;
ARRYOUT(DSKchan,databuf[0],asciiwords);
nbytes ← nbytes+asciibytes;
datap ← ascii0; datacount ← asciibytes; RETURN END
ELSE BEGIN ! Convert image data;
datap ← imag0;
FOR i←0 STEP 2 UNTIL dskwords DO BEGIN
imagbuf[i]←(((ILDB(datap) rot -8 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 lor ILDB(datap)) rot -12
lor lh(w←ILDB(datap) rot -4);
imagbuf[i+1]←((((rh(w) rot -4 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8;
END;
ARRYOUT(DSKchan,imagbuf[0],dskwords);
nbytes ← nbytes+dskwords # logical bytes;
datap ← imag0; datacount ← imagbytes; RETURN END;
IF DLNEOF THEN ! When eof, bytes still in the buffer must be sent to the disk;
IF type=ascii THEN BEGIN ! Complete word and pass data as is;
IF pos(datap)≥36 THEN RETURN ELSE WHILE pos(datap)>1 DO IDPB(0,datap);
ARRYOUT(DSKchan,databuf[0],rh(datap)-rh(ascii0)+1);
nbytes ← nbytes+asciibytes-datacount;
datap ← ascii0; datacount ← asciibytes END
ELSE BEGIN ! Convert image data;
temp_p←datap; datap ← imag0;
FOR i←0 STEP 2 UNTIL dskwords DO BEGIN
imagbuf[i]←(((ILDB(datap) rot -8 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 lor ILDB(datap)) rot -12
lor lh(w←ILDB(datap) rot -4);
imagbuf[i+1]←((((rh(w) rot -4 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8;
IF rh(datap)>rh(temp_p) THEN DONE END;
i ← ((imagbytes-datacount)*2+7) div 9 # number of logical bytes;
ARRYOUT(DSKchan,imagbuf[0],i);
nbytes ← nbytes+i # logical bytes;
datap ← imag0; datacount ← imagbytes; END
END "IDM";
Comment USER issues log-in sequence.
;
SIMPLE PROCEDURE user;
! Sends `USER' command. If needed, also password (read adecuately from terminal).
It may also send `ACCOUNT' if that is the server's wish. usrppn is only set when
the server is satisfied (gave Dn reply)
Here we are assuming that it is the user name that should be verified by the
password, while account numbers can be given freely;
BEGIN "User" INTEGER rep,trials;
sendCommand("(USER " & args & ")") # send command to server;
rep ← reply;
IF rep=Ok THEN ! user has been identified, but a password is required. Only a finite
number of `chances' to try it;
BEGIN trials←0;
DO BEGIN
PRINT(newline,"⊗password=",newline);
TTYUP(FALSE) # recognize lower case in passwords;
CODE(PTJOBX,DOFF) # no echoing;
CODE(LEYPOS,line[1400]) # type off screen;
CALL(nopeek,"TTYSET") # set `no-peek' bit so that TTY's buffer is not displayed;
args ← INCHWL # read password;
CALL(nospy,"TTYSET") # inhibit <control><cr> feature now;
CALL(nopeek,"TTYSET") # clear `no-peek' bit;
CODE(LEYPOS,line[0]) # type at correct place again;
CODE(PTJOBX,DON); # can see again;
TTYUP(TRUE) # everything goes upper case again;
sendCommand("(PASSWORD "&args&")") # send password command ;
rep ← reply;
trials ← trials+1 END
UNTIL (rep≠Failed) OR (trials≥chances);
IF rep=Ok THEN BEGIN ! the password was correct;
trials ← 0;
DO BEGIN ! but an account is required;
PRINT(newline,"⊗account=");
args ← INCHWL;
sendCommand("(ACCOUNT " & args & ")");
trials ← trials+1;
rep ← reply END
UNTIL (rep=Dn) or (trials≥chances); END
END;
END "User";
Comment DATA sets the transfer parameters
;
SIMPLE PROCEDURE data # sets the parameters for data transfer;
BEGIN "Data" STRING bsize,typ,stru; INTEGER tp,bp,bcount;
SCAN(args,skipspaces,chr);
IF "0"≤args≤"9" THEN BEGIN ! user issued whole data specification;
bsize←INTSCAN(args,chr);
SCAN(args,skipspaces,chr);
typ←SCAN(args,oneword,chr);
SCAN(args,skipspaces,chr);
stru←SCAN(args,oneword,chr);
IF ((bsize=7) or (bsize=8)) and EQU(typ,"ASCII") and EQU(stru,"FILE")
THEN BEGIN bsize←7; tp←ascii;
sendCommand("(DATA 8 ASCII FILE)");
bp←ascii0; bcount←asciibytes END
ELSE IF (bsize=36) and EQU(typ,"IMAGE") and EQU(stru,"FILE")
THEN BEGIN tp←image;
sendCommand("(DATA 36 IMAGE FILE)");
bp←imag0; bcount←imagbytes END
ELSE BEGIN PRINT(newline,"Sorry, only `8 ASCII FILE' and `36 IMAGE FILE'",
" implemented");
RETURN END END
ELSE IF args="I" THEN BEGIN ! Image type desired;
sendCommand("(DATA 36 IMAGE FILE)");
bsize←36; tp←image;
bp←imag0; bcount←imagbytes END
ELSE BEGIN ! nothing else can be done but getting the standards;
sendCommand("(DATA 8 ASCII FILE)");
bsize←7; tp←ascii;
bp←ascii0; bcount←asciibytes END;
IF reply=Ok THEN BEGIN
bytesize←bsize; type←tp;
datap←bp; datacount←bcount END
ELSE PRINT(newline,"Server rejected your DATA command");
END "Data";
Comment ABORT, BYE, HELP,STATUS and IDLING.
;
SIMPLE PROCEDURE abort;
! If there is a transfer in progress, an INT packet is sent to the server;
BEGIN "Abort"
CODE(MTAPE,INTcode) # send INT packet;
CODE(MTAPE,FBOcode) # make it go now! ;
sendCommand("(ABORT)") # put a command in the data stream;
IF TransferActive THEN TransferActive←FALSE
ELSE reply;
END "Abort";
SIMPLE PROCEDURE bye;
! A CLS packet is sent to the server;
IF not Closing THEN BEGIN "Bye"
CODE(MTAPE,CLScode);CODE (MTAPE,FBOcode);
END "Bye";
SIMPLE PROCEDURE help # Type out the file RPCUFT.INF[net,sys];
BEGIN "Help" INTEGER Hchan,hbr,heof;
IF TransferActive THEN PRINT(newline,"Type:
`status' to see the status of the transfer
`abort' to abort it
`bye' to abort the transfer and close the connection
`?' to see this information.",newline)
ELSE BEGIN
Hchan ← 10;
OPEN(Hchan,"DSK",0,19,0,'200,hbr,heof);
IF heof THEN BEGIN PRINT(newline,"Sorry, cannot open local disk");RETURN END;
LOOKUP(Hchan,"DLNFTP.IAZ[UP,DOC]",DSKflag);
IF DSKflag THEN PRINT(newline,"Sorry, no help available")
ELSE WHILE not heof DO PRINT(INPUT(Hchan,0));
RELEASE(Hchan); END;
END "Help";
SIMPLE PROCEDURE status(STRING cmd);
BEGIN "Status"
sendCommand("(" & cmd & " " & args & ")");
CASE TransferActive OF BEGIN
[receiving] StatusRequest ← StatusRequest+1;
[sending] BEGIN "Show size of file sent"
reply;
IF EQU(cmd,"STATUS") THEN
PRINT("(Your file has ",filesize," words)",newline);
END "Show size of file sent";
ELSE reply END
END "Status";
SIMPLE BOOLEAN PROCEDURE idling;
! If TransferActive then prints message and returns false;
IF false THEN BEGIN "Busy"
PRINT(newline,"Sorry, "&command&" commands are not allowed during data transfer.",
newline);
RETURN(FALSE) END "Busy"
ELSE RETURN(TRUE);
FORWARD SIMPLE PROCEDURE DoCommand;
Comment RETRIEVE gets data files from server
;
PROCEDURE retrieve;
BEGIN "Retrieve" INTEGER datev,timev;
STRING destination;
INTEGER nocommand,ausent;
SCAN(args,skipspaces,chr);
destination ← get_fname # get destination and put break char in chr;
IF chr=" " THEN SCAN(args,skipspaces,chr);
IF chr≠"←" THEN BEGIN
PRINT(newline,"Error. Correct syntax is: <retrieve command> <dest> ← <source>");
RETURN END;
LOOKUP(DSKchan,destination,ausent) # does destination file already exist?;
RELEASE(DSKchan) # no read-alter mode;
OPEN(DSKchan,"DSK",'10,19,19,DSKcount,DSKbreak,DSKeof);
IF not ausent THEN BEGIN
PRINT(newline,"File "&destination&" already exists. Type Y to replace.");
IF (chr←INCHRW)≠"Y" THEN RETURN END;
ENTER(DSKchan,destination,DSKflag) # prepare destination file;
IF DSKflag THEN BEGIN PRINT(newline,CASE errorcode OF
("Zero file name given",
"PPN for file " & destination & " has no UFD",
"File " & destination & " protection violation",
"File " & destination & " is currently being written",
"","","","",
"Local disk error",
"Local disk error",
"Local disk error"));
RELEASE(DSKchan,3);
OPEN(DSKchan,"DSK",'10,19,19,DSKcount,DSKbreak,DSKeof) END;
sendCommand("(RETRIEVE "&args&")") # send packet with command;
IF (reply≠Ok) THEN BEGIN RELEASE(DSKchan,3);
OPEN(DSKchan,"DSK",'10,19,19,DSKcount,DSKbreak,DSKeof);
PRINT(newline,"The server won't cooperate");RETURN END;
TransferActive ← receiving;
datev ← CALL(0,"DATE"); timev ← CALL(0,"TIMER"); nbytes ← 0;
! Clear buffer;
IF type=ascii THEN BEGIN datap←ascii0; datacount←asciibytes END
ELSE BEGIN datap←imag0; datacount←imagbytes END;
DO IF NOT TransferActive THEN BEGIN "abort exit"
reply # for secondary reply;
WHILE StatusRequest and not Closing DO ! Get status replies;
BEGIN reply;StatusRequest←StatusRequest-1 END;
CLEAR!DLNIOWORD # in case of DLNEOF;
DONE END "abort exit"
ELSE IF DLNEOF THEN BEGIN "normal exit"
RELEASE(DSKchan) # reset pointer in file;
OPEN(DSKchan,"DSK",'10,19,19,DSKcount,DSKbreak,DSKeof);
CLEAR!DLNIOWORD;
reply # for secondary reply;
TransferActive ← FALSE;
datev ← (CALL(0,"DATE")-datev)*86400;
timev ← datev+(CALL(0,"TIMER")-timev)/60;
PRINT(newline,"Bytes received=",nbytes,tab,
" Real time elapsed=",timev," sec.",newline,
"Effective baud rate=",(nbytes*bytesize)/timev,newline,
IF ausent THEN (destination & " entered in directory.")
ELSE ("Old "& destination &" overwritten by new data."),newline);
WHILE StatusRequest and not Closing DO
BEGIN reply;StatusRequest←StatusRequest-1 END;
RETURN END "normal exit"
ELSE BEGIN "receiving data"
DLNtoDSK;
IF (reptosee≠0) or (datachan≠0) THEN BEGIN "status reply"
reply; StatusRequest←StatusRequest-1;
datachan←0 END "status reply";
args ← INCHSL(nocommand);
IF not nocommand THEN BEGIN SCAN(args,skipspaces,chr);
command ← SCAN(args,oneword,chr); DoCommand END;
END "receiving data"
UNTIL Closing;
RELEASE(DSKchan,3) # discard received data;
OPEN(DSKchan,"DSK",'10,19,19,DSKcount,DSKbreak,DSKeof);
PRINT(newline,IF ausent THEN ("File "&destination&" will not be entered in directory.")
ELSE ("Old "&destination&" not modified."),newline);
END "Retrieve";
Comment STORE sends data files to the server
;
PROCEDURE store(BOOLEAN append);
BEGIN "Store" INTEGER nocommand; INTEGER datev,timev;
STRING source;
SCAN(args,skipspaces,chr);
source ← get_fname # get source file and put break char in chr;
IF chr=" " THEN SCAN(args,skipspaces,chr);
IF chr≠"→" THEN BEGIN
PRINT(newline,"Error. Correct syntax is: <store command> <source> → <dest>");
RETURN END;
LOOKUP(DSKchan,source,DSKflag);
IF DSKflag THEN BEGIN
PRINT(newline,CASE errorcode OF
("File " & source & " does not exist",
"PPN for file " & source & " has no UFD",
source & " protection violation",
"File " & source & " currently open in Read-Alter mode",
"",
source & " already open for output",
"","",
"Local disk error",
"Local disk error",
"Local disk error"));
CLOSE(DSKchan); RETURN; END;
FILEINFO(InfoArray); filesize ← -(InfoArray[4] rot 18) # size of file;
sendCommand(IF append THEN "(APPEND "&args&")" ELSE "(STORE "&args&")");
IF (reply≠Ok) THEN BEGIN CLOSE(DSKchan);
PRINT(newline,"The server won't cooperate");RETURN END;
TransferActive ← sending # state of connection;
datev ← CALL(0,"DATE"); timev ← CALL(0,"TIMER"); nbytes ← 0 # for statistics;
DO IF NOT TransferActive THEN
BEGIN "Abort exit"
IF reply≠Stopped THEN ! The secondary reply is not correct;
PRINT(newline,"Server is confused.Better quit now.");
DONE END
ELSE IF DSKeof THEN BEGIN "Normal exit"
CODE(MTAPE,EOFcode); CODE(MTAPE,FBOcode);
RELEASE(DSKchan) # reset pointer in file;
OPEN(DSKchan,"DSK",'10,19,19,DSKcount,DSKbreak,DSKeof);
TransferActive ← FALSE;
IF (reply≠Dn) THEN
PRINT(newline,"Server is confused. Better quit now");
datev ← (CALL(0,"DATE")-datev)*86400;
timev ← datev+(CALL(0,"TIMER")-timev)/60;
PRINT(newline,"Bytes transmitted=",nbytes,tab,
" Real time elapsed=",timev," sec.",newline,
"Effective baud rate=",(nbytes*bytesize)/timev,newline,
"Whole file "&source&" transmitted.",newline);
RETURN END
ELSE BEGIN "sending data"
DSKtoDLN;
args ← INCHSL(nocommand);
IF not nocommand THEN BEGIN SCAN(args,skipspaces,chr);
command ← SCAN(args,oneword,chr); DoCommand END
END "sending data"
UNTIL Closing;
RELEASE(DSKchan) # reset pointer in file;
OPEN(DSKchan,"DSK",'10,19,19,DSKcount,DSKbreak,DSKeof);
PRINT(newline,"We did not send the whole file "&source);
END "Store";
Comment command-table macros
;
! To add a command to the table an statement `build_entry( command )' must be
put in the corresponding place in the sequence that builds the entries and the
corresponding index must be defined. In order to use the command a case
`[command_inx]' must be included in the CASE statement in DoCommand. ;
DEFINE mod_sixbit(seistr) = { (seistr xor '400000000000) };
DEFINE init_table_parm = { REDEFINE cmd_str = {};REDEFINE cmd_ord = 0 };
DEFINE build_entry(kommand) =
{ REDEFINE cmd_str = CVMS(cmd_str) & IFC cmd_ord THENC {,'} ELSEC {'} ENDC &
CVOS(mod_sixbit(CVSIX("kommand"[1 TO 6]))) & {,'} &
CVOS(mod_sixbit(CVSIX("kommand"[7 TO 12])));
REDEFINE cmd_ord = cmd_ord + 1;
};
DEFINE build_command_table (table_name) =
{ PRELOAD_WITH cmd_str;
OWN SAFE INTEGER ARRAY table_name[1:cmd_ord,1:2]
};
! Build table of commands. Input them in order of increasing sixbit codes;
init_table_parm;
build_entry(?); DEFINE WHAT_inx = cmd_ord;
build_entry(ABORT); DEFINE ABORT_inx = cmd_ord;
build_entry(ACCOUNT); DEFINE ACCOUNT_inx = cmd_ord;
build_entry(ALIAS); DEFINE ALIAS_inx = cmd_ord;
build_entry(APPEND); DEFINE APPEND_inx = cmd_ord;
build_entry(BYE); DEFINE BYE_inx = cmd_ord;
build_entry(CWD); DEFINE CWD_inx = cmd_ord;
build_entry(DATA); DEFINE DATA_inx = cmd_ord;
build_entry(DELETE); DEFINE DELETE_inx = cmd_ord;
build_entry(DIRECTORY); DEFINE DIRECTORY_inx = cmd_ord;
build_entry(GET); DEFINE GET_inx = cmd_ord;
build_entry(HELP); DEFINE HELP_inx = cmd_ord;
build_entry(KILL); DEFINE KILL_inx = cmd_ord;
build_entry(LOGIN); DEFINE LOGIN_inx = cmd_ord;
build_entry(PASSWORD); DEFINE PASSWORD_inx = cmd_ord;
build_entry(PUT); DEFINE PUT_inx = cmd_ord;
build_entry(QUIT); DEFINE QUIT_inx = cmd_ord;
build_entry(RENAME); DEFINE RENAME_inx = cmd_ord;
build_entry(RETRIEVE); DEFINE RETRIEVE_inx = cmd_ord;
build_entry(SEND); DEFINE SEND_inx = cmd_ord;
build_entry(SERVER); DEFINE SERVER_inx = cmd_ord;
build_entry(STATUS); DEFINE STATUS_inx = cmd_ord;
build_entry(STORE); DEFINE STORE_inx = cmd_ord;
build_entry(USER); DEFINE USER_inx = cmd_ord;
build_command_table(cmd_table);
Comment MIN_MATCH command in the table and DOCOMMAND
;
SIMPLE INTEGER PROCEDURE min_match(SAFE INTEGER ARRAY table;STRING str);
BEGIN "Minimum unambiguous match"
! Looks up the STR in the command table TABLE, returning 0 if STR is not a
prefix of any entry, or +k if STR is the prefix of only TABLE[k,1:2], or -1
if it is ambiguous. It is assumed the table is sorted.;
INTEGER leftmin,rightmin,leftmax,rightmax,table_max,k;
STRING str2;
leftmin ← mod_sixbit (CVSIX (str2 ← str & " "));
rightmin ← mod_sixbit (CVSIX (str2[7 to 12]));
leftmax ← mod_sixbit (CVSIX (str2 ← str & "←←←←←←←←←←←←"));
rightmax ← mod_sixbit (CVSIX (str2[7 to 12]));
table_max ← ARRINFO (table,2);
FOR k ← 1 THRU table_max DO
IF leftmin<table[k,1] OR (leftmin=table[k,1] AND rightmin≤table[k,2]) THEN BEGIN
IF leftmax<table[k,1] OR (leftmax=table[k,1] AND rightmax<table[k,2])
THEN RETURN(0);
IF k=table_max OR (leftmin=table[k,1] AND rightmin=table[k,2]) OR
leftmax<table[k+1,1] OR (leftmax=table[k+1,1] AND rightmax<table[k+1,2])
THEN RETURN(K);
RETURN(-1) END;
RETURN(0)
END "Minimum unambiguous match";
SIMPLE PROCEDURE DoCommand;
! Calls the appropiate routine to deal with the given command (its code word
has been stored in command);
BEGIN "Do Command" STRING source,destination,rep;
IF Closing THEN RETURN;
CASE min_match(cmd_table,command) OF BEGIN
[0] PRINT("Unrecognized command (`?' for options).",newline);
[ACCOUNT_inx] IF idling THEN BEGIN sendCommand("(ACCOUNT "&args&")");
rep←reply;
IF (rep≠Ok) and (rep≠Dn) THEN
PRINT(newline,"Server rejected your ACCOUNT command") END;
[PASSWORD_inx] IF idling THEN BEGIN sendCommand("(PASSWORD "&args&")");
rep←reply;
IF (rep≠Ok) and (rep≠Dn) THEN
PRINT(newline,"Server rejected your PASSWORD command") END;
[DATA_inx] IF idling THEN data;
[RENAME_inx] IF idling THEN BEGIN sendCommand("(RENAME "&args&")");
IF reply≠Ok THEN
PRINT(newline,"Server rejected your RENAME command") END;
[DIRECTORY_inx] IF idling THEN BEGIN sendCommand("(DIRECTORY "&args&")");
IF reply≠Ok THEN
PRINT(newline,"Server rejected your DIRECTORY command") END;
[ALIAS_inx]
[CWD_inx] IF idling THEN BEGIN sendCommand("(CWD "&args&")");
IF reply≠Ok THEN
PRINT(newline,"Server rejected your CWD command") END;
[DELETE_inx] IF idling THEN BEGIN sendCommand("(DELETE " & args & ")");
reply END;
[LOGIN_inx]
[USER_inx] IF idling THEN user;
[STATUS_inx] status("STATUS");
[SERVER_inx] status("SERVER");
[GET_inx]
[RETRIEVE_inx] IF idling THEN retrieve;
[PUT_inx] [SEND_inx]
[STORE_inx] IF idling THEN store(NoApnd);
[APPEND_inx] IF idling THEN store(Apnd);
[ABORT_inx] abort;
[QUIT_INX] [KILL_inx]
[BYE_inx] bye;
[HELP_inx][WHAT_inx] help;
ELSE PRINT("Ambiguous command",newline)
END
END "Do Command";
Comment Main user program. Initializations
;
DLNchan ← 1 # for Dialnet I/O;
DSKchan ← 2 # for disk I/O;
! Set UUO codes and AC fields;
MTAPE ← '072000000000+ACfield*DLNchan # for Dialnet commands;
DLNINPUT← '066000000000+ACfield*DLNchan # to input from Dialnet;
DLNOUTPUT←'067000000000+ACfield*DLNchan # to output to Dialnet;
DLNSETST← '060000000000+ACfield*DLNchan # to set IOWORD for Dialnet device;
DLNGETST← '062000000000+ACfield*DLNchan # to get IOWORD for Dialnet device;
PTJOBX ← '711000000000+ACfield*'16 # to set/clear terminal echo;
LEYPOS ← '702000000000+ACfield*'6 # to hide terminal input;
RPCcode ← 0; CLScode ← 1; EOFcode ← 3;
INTcode ← 4; FBOcode ← 5; WFCcode ← 7;
EOFchan ← datachan; INTchan ← comchan # channels for end_of_file and interrupt;
! Initialize parameters to read passwords;
DON ← 0; DONN ← 4; DOFF ← 0; DOFFF ← 3;
inhibit ← '10000000000; nospy ← (-1 LSH 18) + loc(inhibit);
blind ← '30000000000; nopeek ← (-1 LSH 18) + loc(blind);
! Initialize transfer parameters;
bytesize ← 7; type ← ascii;
! Initialize buffer parameters;
datap ← ascii0; datacount ← asciibytes; datachan ← 0;
comp ← com0; comcount ← combytes; comchan ← 1;
repp ← rep0; repcount ← repbytes; repchan ← 2; reptosee ← 0;
! Initialize break tables;
skipspaces ← GETBREAK;
SETBREAK(skipspaces," ","","xnr");
oneword ← GETBREAK;
SETBREAK(oneword," ←→","","inr");
oneatom ← GETBREAK;
SETBREAK(oneatom,ALPHA & NUMER,"","xns");
fname ← GETBREAK;
SETBREAK(fname,"←→ ,[","","ins");
uptoquote ← GETBREAK;
SETBREAK(uptoquote,"↓","","ina");
! Allow CLOSE interrupts;
INTMAP(INTIMS_INX,DoCLS,0);
ENABLE(INTIMS_INX);
! Initial conditions;
DLNIOWORD ← 0;
TransferActive ← FALSE;
Closing ← FALSE;
StatusRequest ← FALSE;
TTYUP(TRUE) # convert alphabetic terminal input to upper case;
Comment Run!!
;
OPEN(DSKchan,"DSK",'10,19,19,DSKcount,DSKbreak,DSKeof);
IF DSKeof THEN PRINT(newline,"Sorry, cannot open local disk.")
ELSE IF connect THEN
BEGIN "Connected"
! Get greeting message;
IF reply=Ok THEN BEGIN
PRINT(newline,"Ready for commands",newline);
WHILE NOT Closing DO BEGIN
PRINT(newline,"⊗");
args ← INCHWL;SCAN(args,skipspaces,chr);
command ← SCAN(args,oneword,chr);
DoCommand;
END
END;
PRINT(newline,"Connection broken.");
RELEASE(DLNchan);
END "Connected";
RELEASE(DSKchan);
PRINT("Bye");
END "User FTP"